home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Original Shareware 1.1
/
The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso
/
18
/
fpc103.zip
/
STATUS.SEQ
< prev
next >
Wrap
Text File
|
1988-06-23
|
2KB
|
45 lines
\ STATUS.SEQ Display a status line at screen top. by Tom Zimmer
: <.STAT> ( --- )
#OUT @ #LINE @ >R >R
ATTRIB C@ >R
BASE @ >R DECIMAL
0 0 AT >ATTRIB1
." C - " SP@ HERE - 0 1000 um/mod nip (U.) TYPE ." k : - "
#LISTSEGS XHERE DROP XSEG @ - - 16 *D
1000 um/mod nip (U.) TYPE ." k"
2 spaces DEPTH
IF >ATTRIB4 ." Depth " DEPTH (U.) DUP >R TYPE
4 R> - SPACES >ATTRIB1
ELSE ." Stack Empty"
THEN 2 spaces SHNDL @ >HNDLE @ -1 =
IF shndl @ dup clr-hcb pathset drop
-2 shndl @ >hndle !
THEN .SHNDL 80 #OUT @ DUP >R - 0 MAX SPACES
R> 57 <
IF 57 0 AT
CONTEXT @ BODY> >NAME .ID BL FEMIT
CURRENT @ BODY> >NAME .ID
THEN 74 0 AT BL FEMIT
GETTIME <.HM> DROP >NORM
R> BASE ! R> ATTRIB C! R> R> AT ;
: .STATUS ( -- )
DEFERS STATUS
?STACK
STATV @
IF <.STAT>
THEN ;
' .STATUS IS STATUS \ Status printed for command lines.
' <.STAT> IS LOADSTAT \ Status printed while loading.
: STATON ( --- )
STATV ON ;
: STATOFF ( --- )
STATV OFF ;
STATON \ DEFAULT TO DISPLAYING STATUS LINE.